c	sel1	version 1.1
c
c	joel hasbrouck
c
c	torq data selection program
c
c	this program constructs ascii subsets of the torq data.
c
c	for conversion to other compilers/operating systems, you may
c	need to change the open statements and the subroutine getcline.

	include 'sel1.cmb'
	include 'torqfils.cmb'
	integer*4 nsym,isym,idate,nrecmap

c	get & echo command line parameters
	call getcline
	write(*,*) 'sel1 v. 1.1 command line:'
	write(*,101) symbol1,symbol2,tdate1,tdate2,selcode,ofmt
101	format(' sel1',2(1x,a3),2i7,2(1x,a4))
	write(*,*) 'Input parameters:'
	write(*,*) 'Retrieving symbols from ',symbol1, ' to ',symbol2
	write(*,*) 'Retrieving dates from ',tdate1,' to ',tdate2
	write(*,*) 'Selecting: ',selcode,'; Output format is: ',ofmt

c	open all files
	call fopen
	psize = 15

c	loop over name file to read in all symbols
	do 10 nsym=1,150
	read(krnm,100,end=11) symbolnm
100	format(a3)
10	fsym(nsym) = symbolnm
11	nsym = nsym - 1

c	loop over symbols, checking to see if data should be retrieved.
	do 20 isym=1,nsym
	if (fsym(isym).lt.symbol1 .or. fsym(isym).gt.symbol2) goto 20
	write(*,*) 'retrieving data for ',fsym(isym),' . . .'

c	loop over all dates.
	do 21 idate=1,63
c	read in map record for symbol/date
	nrecmap = (isym-1)*63 + idate
	read(krmap,rec=nrecmap) symbolmp,tdatemp,ct1,ct2,nct,cq1,cq2,ncq,
     $	cd1,cd2,ncd,sd1,sd2,nsd

c	is this date in valid range?
	if (tdatemp.lt.tdate1 .or. tdatemp.gt.tdate2) goto 21
	write(*,*) 'retrieving data for ',tdatemp

c	consolidate transaction retrieval.
	if (getct) call selct

c	consolidated quote retrieval.
	if (getcq) call selcq

c	audit trail retrieval.
	if (getcd) call selcd

c	sod file retrieval.
	if (getsod) call selsod

c	end of date loop.
21	continue

c	end of symbol loop.
20 	continue

	write(*,102)
102	format(' sel1ct.asc contains any transaction records'
     $	/' sel1cq.asc contains any quote records'
     $	/' sel1cd.asc contains any audit records'
     $	/' sel1sd.asc contains any system order database records')
	
	end
c--------------------------------------------------------------------------
	subroutine selct
c	read/write data for transaction record.
	include 'sel1.cmb'
	include 'torqfils.cmb'
	integer*4 nline/0/,i,nrecct
	character chhmmss*8

	write(*,*) nct,' transactions found.'
	if (nct.eq.0) goto 99
	do 10 i=1,nct

	nrecct = ct1 + i - 1
	read(krct,rec=nrecct) condct,exct,g127,pricect,sizct,
     $	symbolct,tdatect,tseq,ttim,null01

	if (ofmt.eq.'LIST') then
		if (nline.eq.0) write(kwct,100)
100		format('sym  tdate     ttim ex     price    siz cond g127',
     $		'   tseq')
		nline = nline + 1
		write(kwct,101) symbolct,tdatect,chhmmss(ttim),exct,
     $		float(pricect)/256.,sizct,condct,g127,tseq
101		format(a3,i7,1x,a8,2x,a1,f10.5,i7,4x,a1,i5,i7,i7)
		if (nline.gt.psize) nline = 0
	else
		write(kwct,102) symbolct,tdatect,ttim,exct,
     $		float(pricect)/256.,sizct,condct,g127,tseq
102		format(a3,i6,i6,a1,f10.5,i7,a1,i3,i6)
	endif
10	continue
99	return
	end
c--------------------------------------------------------------------------
	subroutine selcq
c	read/write data for quote record.
	include 'sel1.cmb'
	include 'torqfils.cmb'
	integer*4 nline/0/,i,nreccq
	character chhmmss*8

	write(*,*) ncq,' quotes found.'
	if (ncq.eq.0) goto 99
	do 10 i=1,ncq

	nreccq = cq1 + i - 1
	read(krcq,rec=nreccq) symbolcq,tdatecq,qtim,bid,ofr,
     $	bidsiz,ofrsiz,mode,qseq,excq,null02

	if (ofmt.eq.'LIST') then
		if (nline.eq.0) write(kwcq,100)
100		format('sym  tdate     qtim ex       bid       ofr',
     $		' bidsiz ofrsiz mode   qseq')
		nline = nline + 1
		write(kwcq,101) symbolcq,tdatecq,chhmmss(qtim),excq,
     $		float(bid)/256.,float(ofr)/256.,bidsiz,ofrsiz,
     $		mode,qseq
101		format(a3,i7,1x,a8,2x,a1,2f10.5,2i7,i5,i7)
		if (nline.gt.psize) nline = 0
	else
		write(kwcq,102) symbolcq,tdatecq,qtim,excq,
     $		float(bid)/256.,float(ofr)/256.,bidsiz,ofrsiz,
     $		mode,qseq
102		format(a3,i6,i6,a1,2f10.5,2i6,i5,i7)
	endif
10	continue
99	return
	end
c--------------------------------------------------------------------------
	subroutine selcd
c	read/write data for audit trail record.
	include 'sel1.cmb'
	include 'torqfils.cmb'
	integer*4 i,nreccd
	character chhmmss*8

	write(*,*) ncd,' audit trail records found.'
	if (ncd.eq.0) goto 99

	do 10 i=1,ncd

	nreccd = cd1 + i - 1
	read(krcd,rec=nreccd) btype,buyacct,null08,buycomp,
     $	buytim,condcd,corr,excd,origsiz,pricecd,selacct,
     $	null09,selcomp,seltim,seqnum,sizcd,stype,subseq,symbolcd,
     $	tdatecd,ttimcd

	if (ofmt.eq.'LIST') then
		write(kwcd,100)
100		format(/'symbol  tdate     ttim     price    siz  seqnum',
     $	' subseq cond corr ex origsiz')
		write(kwcd,101) symbolcd,tdatecd,chhmmss(ttimcd),
     $	float(pricecd)/256.,sizcd,seqnum,subseq,condcd,corr,excd,
     $	origsiz
101		format(3x,a3,i7,1x,a8,f10.5,i7,i8,i7,4x,a1,3x,a2,2x,a1,i8)
		write(kwcd,102)
102		format('btype buyacct   buytim buycomp',
     $	' selcomp   seltim selacct stype')
		write(kwcd,103) btype,buyacct,chhmmss(buytim),buycomp,
     $	selcomp,chhmmss(seltim),selacct,stype
103		format(3x,a2,7x,a1,1x,a8,i8,i8,1x,a8,7x,a1,4x,a2)
	else
		write(kwcd,104) symbolcd,tdatecd,ttimcd,
     $		float(pricecd)/256.,
     $		sizcd,seqnum,subseq,condcd,corr,excd,origsiz,
     $		btype,buyacct,buytim,buycomp,
     $		selcomp,seltim,selacct,stype
104		format(a3,i6,i6,f10.5,i6,i6,i5,a1,a2,a1,i6,a2,a1,i6,
     $		i6,i6,i6,a1,a2)
	endif
10	continue
99	return
	end
c--------------------------------------------------------------------------
	subroutine selsod
c	read/write sod record.
	include 'sel1.cmb'
	include 'torqfils.cmb'
	integer*4 i,j,nrecsod

	write(*,*) nsd,' system order database records found.'
	if (nsd.eq.0) goto 99
	do 10 j=1,nsd

	nrecsod = sd1 + j - 1
	read(krsod,rec=nrecsod) acctyp,aprice,atime,atype,book,
     $	clrcode,null06,conqty,contra,cxlqty,null10,execpr,null04,
     $	flrind,ind,indtot,lmtpr,lvsqty,ocode,ocond,odate,omni,
     $	oqual,order,oshrs,oside,otime,null05,rshrs,rtime,stppr,
     $	symbolsd,null07,tdatesd,tif

	if (ofmt.eq.'LIST') then
		call prtsod
	else
		write(kwsod,110) symbolsd,tdatesd,odate,otime,
     $	order,ind,indtot,flrind,book,omni,oside,ocode,ocond,oshrs,
     $	float(lmtpr)/256.,float(stppr)/256.,acctyp,tif,oqual,
     $	atype,atime,float(aprice)/256.,
     $	cxlqty,rtime,rshrs,clrcode,
     $	float(execpr)/256.,lvsqty,(conqty(i),contra(i),i=1,4)
110		format(a3,i6,i6,i6,
     $	a1,i4,i4,a1,a1,a1,a3,a2,a1,i6,
     $	f10.5,f10.5,a1,a1,i4,
     $	a1,i6,f10.5,
     $	i6,i6,i6,a2,
     $	f10.5,i6,4(i6,a4))
	endif
10	continue
99	return
	end
c--------------------------------------------------------------------------
	subroutine prtsod
	include 'sel1.cmb'
	include 'torqfils.cmb'
	integer*4 i
	character chhmmss*8

	write(kwsod,100)
100	format(/' symbol  tdate  odate    otime order ind indtot flrind',
     $	' book omni clrcode')
	write(kwsod,101) symbolsd,tdatesd,odate,chhmmss(otime),order,
     $	ind,indtot,flrind,book,omni,clrcode
101	format(4x,a3,i7,i7,1x,a8,5x,a1,i4,i7,6x,a1,4x,a1,4x,a1,6x,a2)
	write(kwsod,102)
102	format(' oside ocode ocond oshrs     lmtpr     stppr acctyp tif',
     $	' oqual')
	write(kwsod,103) oside,ocode,ocond,oshrs,float(lmtpr)/256.,
     $	float(stppr)/256.,acctyp,tif,oqual
103	format(3x,a3,4x,a2,5x,a1,i6,2f10.5,6x,a1,3x,a1,i6)
	write(kwsod,104)
104	format(' atype    atime    aprice cxlqty',
     $	'    rtime rshrs    execpr lvsqty clrcode')
	write(kwsod,105) atype,chhmmss(atime),float(aprice)/256.,
     $	cxlqty,chhmmss(rtime),rshrs,float(execpr)/256.,lvsqty,
     $	clrcode
105	format(5x,a1,1x,a8,f10.5,i7,1x,a8,i6,f10.5,i7,6x,a2)
	write(kwsod,108) 
108	format('  conqty1 contra1 conqty2 contra2',
     $	' conqty3 contra3 conqty4 contra4')
	write(kwsod,109) (conqty(i),contra(i),i=1,4)
109	format(1x,4(i8,4x,a4))
	return
	end
c--------------------------------------------------------------------------
	subroutine fopen
c	open all files used by the program.
	include 'sel1.cmb'

c	open input torq files.
	call tfilopen

c	output files:
	kwct = 10
	call filop(kwct,'sel1ct.asc')
	kwcq = 11
	call filop(kwcq,'sel1cq.asc')
	kwcd = 12
	call filop(kwcd,'sel1cd.asc')
	kwsod = 13
	call filop(kwsod,'sel1sd.asc')

	end
c--------------------------------------------------------------------------
	subroutine filop(kunit,filename)
c	initialize a sel1**.asc file
	logical lexist
	integer kunit
	character*(*) filename
	inquire (file=filename,exist=lexist)
	if (lexist) then
		open (unit=kunit,file=filename,status='old')
		close (unit=kunit,status='delete')
	endif
	open (unit=kunit,file=filename,status='new')
	return
	end
c--------------------------------------------------------------------------
	subroutine getcline

c	returns command line parameters.
c
c	form of command line is:
c	select symbol1 symbol2 tdate1 tdate2 selcode ofmt
c	where
c	symbol1		first symbol to retrieve
c	symbol2		last symbol
c	tdate1		first tdate to retrieve (YYMMDD)
c	tdate2		last tdate
c	optional parameters:
c	selcode	 	some combination of the characters T, Q, S, A
c				(for trade, quote, sod, audit)
c	ofmt			output format: LIST or DATA
c	
c	the variables getct, getcq, getsod, getcd are logical variables
c	that are set to .true. if the indicated data (ct, cq, sod, cd)
c	are selected based on selcode.
c
c	this subprogram contains a lot of ms-dos fortran-specific code.
c	if you are modifying the program for another machine or compiler,
c	this routine must be changed. Of course, in your particular application
c	there may be no need to get the arguments from the command line.
c	you may wish to have them permanently set in the program, or else you
c	might read them in from another file.

	include 'sel1.cmb'
	integer*2 istat
	integer*4 na,nargs
	character buffer*20,upper*20

c	these are the defaults:
	symbol1 = 'AC'
	symbol2 = 'AC'
	tdate1 = 901101
	tdate2 = 901101
	selcode = 'TQSA'
	ofmt = 'LIST'

	na = nargs() - 1
	if (na.gt.0) call getarg(1,symbol1,istat)
	symbol1 = upper(symbol1)
	if (na.gt.1) call getarg(2,symbol2,istat)
	symbol2 = upper(symbol2)
	if (symbol2.lt.symbol1) symbol2 = symbol1
	if (na.gt.2) then
		call getarg(3,buffer,istat)
		read(buffer,'(i6)') tdate1
	endif
	if (na.gt.3) then
		call getarg(4,buffer,istat)
		read(buffer,'(i6)') tdate2
	endif
	if (tdate2.lt.tdate1) tdate2 = tdate1
	getct = .true.
	getcq = .true.
	getsod = .true.
	getcd = .true.
	if (na.gt.4) then
		call getarg(5,selcode,istat)
		selcode = upper(selcode)
		if (index(selcode,'T').eq.0) getct = .false.
		if (index(selcode,'Q').eq.0) getcq = .false.
		if (index(selcode,'S').eq.0) getsod = .false.
		if (index(selcode,'A').eq.0) getcd = .false.
	endif
	if (na.gt.5) then
		call getarg(6,ofmt,istat)
		ofmt = upper(ofmt)
		if (ofmt.ne.'LIST' .and. ofmt.ne.'DATA') then
			write(*,*) 'expecting LIST or DATA. got ',ofmt
			stop
		endif
	endif

	return
	end

	include 'torqsubs.for'
